Trabajo Final Wisconsin
Diego Maquedano Pedrero
12/8/2020
Introducción y preproceso de los datos
En esta práctica lo que se va a analizar es un conjunto de datos proveniente de un parque de atracciones de Wisconsin en el que los datos están recogidos a modo de encuesta y se pretende conocer más sobre la tipologÃa y caracterÃsticas de los clientes.
Antes que nada, se comprueba si los paquetes a emplear están correctamente cargados
comprobar <- function(pkg){
new.pkg <- pkg[!(pkg %in% installed.packages()[, "Package"])]
if (length(new.pkg))
install.packages(new.pkg, dependencies = TRUE)
sapply(pkg, require, character.only = TRUE)
}
paquetes<-c("tidyverse","factoextra","FactoMineR","plfm","cluster",
"ggplot2","VIM","mice","corrplot","psych","Hmisc",
"NbClust","anacor","ca","gplots","naniar","missMDA","gmodels",
"scales","descr")
comprobar(paquetes)## tidyverse factoextra FactoMineR plfm cluster ggplot2 VIM
## TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## mice corrplot psych Hmisc NbClust anacor ca
## TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## gplots naniar missMDA gmodels scales descr
## TRUE TRUE TRUE TRUE TRUE TRUEA continuación, descargamos los datos (se puede emplear choose.file() pero en markdown no funciona) en el directorio de trabajo que vamos a usar. A su vez, establecemos que el nombre de las filas sea el ID del cliente para más comodidad.
setwd("C:/Users/Diego/Desktop/Introduction to data mining/TRabajo_final_individual_2")
datos<-read.csv("wisconsin_dells.csv",row.names = 1)Explorando los datos en Excel, se comprueba que es un conjunto de datos obtenido mediante encuesta pues la totalidad de las variables son o binarias o para indicar frecuencia por lo que el modo más adecuado de obtener información del mismo va a ser usando mapas perceptuales y análisis de correspondencia.
Como siempre, comviene echar un vistazo general a los datos para comprobar observaciones faltantes o caracterÃsticas generales
glimpse(datos)## Rows: 1,698
## Columns: 42
## $ nnights <chr> "3", "3", "4+", "3", "4+", "0", "1", "4+", "0", "3",...
## $ nadults <chr> "2", "4", "2", "1", "5+", "2", "2", "5+", "2", "2", ...
## $ nchildren <chr> "3", "5+", "2", "1", "5+", "4", "4", "2", "No kids",...
## $ planning <chr> "This Month", "One Month or More Ago", "One Month or...
## $ sex <chr> "Female", "Male", "Male", "Female", "Female", "Male"...
## $ age <chr> "35-44", "35-44", "35-44", "35-44", "35-44", "35-44"...
## $ education <chr> "HS Grad or Less", "College Grad", "College Grad", "...
## $ income <chr> "Lower Income", "", "Lower Income", "Lower Income", ...
## $ region <chr> "Other", "Minneapolis/StPaul", "Chicago", "Chicago",...
## $ shopping <chr> "YES", "YES", "YES", "YES", "YES", "YES", "YES", "YE...
## $ antiquing <chr> "NO", "NO", "NO", "NO", "NO", "NO", "NO", "NO", "YES...
## $ scenery <chr> "YES", "YES", "YES", "YES", "YES", "NO", "NO", "YES"...
## $ eatfine <chr> "YES", "NO", "NO", "NO", "NO", "NO", "YES", "NO", "Y...
## $ eatcasual <chr> "YES", "YES", "YES", "YES", "YES", "NO", "NO", "YES"...
## $ eatfamstyle <chr> "YES", "YES", "NO", "YES", "YES", "NO", "YES", "YES"...
## $ eatfastfood <chr> "YES", "YES", "YES", "YES", "YES", "NO", "YES", "YES...
## $ museums <chr> "NO", "YES", "NO", "YES", "YES", "NO", "YES", "YES",...
## $ indoorpool <chr> "YES", "YES", "NO", "YES", "NO", "NO", "YES", "YES",...
## $ outdoorpool <chr> "YES", "YES", "YES", "YES", "NO", "NO", "YES", "YES"...
## $ hiking <chr> "NO", "NO", "NO", "NO", "YES", "NO", "NO", "NO", "NO...
## $ gambling <chr> "YES", "NO", "NO", "NO", "YES", "NO", "NO", "NO", "N...
## $ boatswim <chr> "YES", "YES", "YES", "YES", "YES", "NO", "YES", "YES...
## $ fishing <chr> "NO", "NO", "YES", "NO", "NO", "NO", "NO", "NO", "NO...
## $ golfing <chr> "NO", "NO", "YES", "YES", "YES", "NO", "NO", "NO", "...
## $ boattours <chr> "YES", "YES", "YES", "YES", "NO", "NO", "YES", "YES"...
## $ rideducks <chr> "YES", "YES", "YES", "YES", "NO", "NO", "YES", "YES"...
## $ amusepark <chr> "YES", "NO", "YES", "YES", "YES", "NO", "YES", "YES"...
## $ minigolf <chr> "YES", "YES", "YES", "YES", "YES", "NO", "YES", "YES...
## $ gocarting <chr> "YES", "YES", "YES", "YES", "YES", "YES", "YES", "YE...
## $ waterpark <chr> "YES", "NO", "YES", "YES", "YES", "NO", "YES", "YES"...
## $ circusworld <chr> "NO", "NO", "NO", "YES", "YES", "NO", "NO", "NO", "N...
## $ tbskishow <chr> "YES", "YES", "YES", "NO", "NO", "NO", "NO", "NO", "...
## $ helicopter <chr> "NO", "NO", "NO", "NO", "NO", "NO", "NO", "NO", "NO"...
## $ horseride <chr> "NO", "NO", "YES", "NO", "NO", "NO", "NO", "YES", "N...
## $ standrock <chr> "NO", "YES", "YES", "NO", "YES", "NO", "NO", "NO", "...
## $ outattract <chr> "NO", "YES", "YES", "YES", "YES", "NO", "NO", "YES",...
## $ nearbyattract <chr> "NO", "YES", "YES", "YES", "NO", "NO", "NO", "YES", ...
## $ movietheater <chr> "NO", "NO", "NO", "NO", "NO", "NO", "NO", "NO", "NO"...
## $ concerttheater <chr> "NO", "NO", "YES", "NO", "NO", "NO", "NO", "NO", "NO...
## $ barpubdance <chr> "NO", "NO", "NO", "NO", "NO", "NO", "NO", "YES", "YE...
## $ shopbroadway <chr> "YES", "NO", "YES", "NO", "YES", "NO", "NO", "YES", ...
## $ bungeejumping <chr> "NO", "NO", "NO", "NO", "NO", "NO", "NO", "NO", "NO"...colSums(is.na(datos))## nnights nadults nchildren planning sex
## 0 0 0 0 0
## age education income region shopping
## 0 0 0 0 0
## antiquing scenery eatfine eatcasual eatfamstyle
## 0 0 0 0 0
## eatfastfood museums indoorpool outdoorpool hiking
## 0 0 0 0 0
## gambling boatswim fishing golfing boattours
## 0 0 0 0 0
## rideducks amusepark minigolf gocarting waterpark
## 0 0 0 0 0
## circusworld tbskishow helicopter horseride standrock
## 0 0 0 0 0
## outattract nearbyattract movietheater concerttheater barpubdance
## 0 0 0 0 0
## shopbroadway bungeejumping
## 0 0apply(datos, 2, range)## nnights nadults nchildren planning sex age
## [1,] "0" "1" "1" "One Month or More Ago" "Female" ""
## [2,] "4+" "5+" "No kids" "This Week" "Male" "LT 25"
## education income region shopping antiquing scenery
## [1,] "" "" "" "NO" "NO" "NO"
## [2,] "Some College" "Upper Income" "Other Wisconsin" "YES" "YES" "YES"
## eatfine eatcasual eatfamstyle eatfastfood museums indoorpool outdoorpool
## [1,] "NO" "NO" "NO" "NO" "NO" "NO" "NO"
## [2,] "YES" "YES" "YES" "YES" "YES" "YES" "YES"
## hiking gambling boatswim fishing golfing boattours rideducks amusepark
## [1,] "NO" "NO" "NO" "NO" "NO" "NO" "NO" "NO"
## [2,] "YES" "YES" "YES" "YES" "YES" "YES" "YES" "YES"
## minigolf gocarting waterpark circusworld tbskishow helicopter horseride
## [1,] "NO" "NO" "NO" "NO" "NO" "NO" "NO"
## [2,] "YES" "YES" "YES" "YES" "YES" "YES" "YES"
## standrock outattract nearbyattract movietheater concerttheater barpubdance
## [1,] "NO" "NO" "NO" "NO" "NO" "NO"
## [2,] "YES" "YES" "YES" "YES" "YES" "YES"
## shopbroadway bungeejumping
## [1,] "NO" "NO"
## [2,] "YES" "YES"Todas las variables son string porque, aunque hay algunas discretas, poseen caracteres comoel signo más para indicar un valor superior a las posibilidades dadas. Si intentamos ver cuántos datos faltantes hay considerando NA el resultado es que no existe ninguno pero viendo, por ejemplo la variable income
head(datos$income,5)## [1] "Lower Income" "" "Lower Income" "Lower Income" ""Vemos que hay casillas vacÃas que bien puede deberse a que el cliente se negó a facilitar la información o simplemente se ha perdido. Estos datos, para un tratamiento más claro de los mismos es mejor sustituirlos por NA asà que procedemos a ello.
datos<-mutate_all(datos, list(~na_if(.,"")))Y ya sà que se pueden emplear paquetes anteriores para visualizar cómo se distribuyen estos datos faltantes
plot_NA <- aggr(datos, col=c('lightblue','red'), numbers=TRUE,
sortVars=TRUE, labels=names(datos),
cex.axis=.3,
gap=3, ylab=c("Histogram of missing data","Pattern"))
##
## Variables sorted by number of missings:
## Variable Count
## income 0.157243816
## region 0.022968198
## education 0.011778563
## age 0.005889282
## nnights 0.000000000
## nadults 0.000000000
## nchildren 0.000000000
## planning 0.000000000
## sex 0.000000000
## shopping 0.000000000
## antiquing 0.000000000
## scenery 0.000000000
## eatfine 0.000000000
## eatcasual 0.000000000
## eatfamstyle 0.000000000
## eatfastfood 0.000000000
## museums 0.000000000
## indoorpool 0.000000000
## outdoorpool 0.000000000
## hiking 0.000000000
## gambling 0.000000000
## boatswim 0.000000000
## fishing 0.000000000
## golfing 0.000000000
## boattours 0.000000000
## rideducks 0.000000000
## amusepark 0.000000000
## minigolf 0.000000000
## gocarting 0.000000000
## waterpark 0.000000000
## circusworld 0.000000000
## tbskishow 0.000000000
## helicopter 0.000000000
## horseride 0.000000000
## standrock 0.000000000
## outattract 0.000000000
## nearbyattract 0.000000000
## movietheater 0.000000000
## concerttheater 0.000000000
## barpubdance 0.000000000
## shopbroadway 0.000000000
## bungeejumping 0.000000000El resultado es que el 82% de las observaciones no contienen NA siendo la variable que más posee income. Otra alternativa muy buena a ver estos datos faltantes es usando la librerÃa naniar que posee múltiples funciones para ello
gg_miss_var(datos)
Este gráfico es muy sencillo y enseña que sólo las variables income, education, region y age poseen NA
gg_miss_upset(datos)
Este es más complejo y a parte de mostrar NA, muestra intersecciones entre variables calificadas de esa misma manera. Por ejemplo, hay 5 observaciones en las que age, education e income tienen NA. El resto de gráfico es interpretable de manera análoga a ello.
PodrÃamos considerar la eliminación de estas observaciones pero la proporción de datos faltantes (11%) es muy elevada asà que los imputamos usando la función imputeMCA del paquete missMCA que introduce estos NA mediante Análisis de Correspondencia Múltiple.
Antes de hacerlo, convertimos esas variables en factores para que resulte más rápida la elección de posibles valores (posteriormente es más conveniente convertir todas las variables a factor)
datos$age<-as.factor(datos$age)
datos$income<-as.factor(datos$income)
datos$region<-as.factor(datos$region)
datos$education<-as.factor(datos$education)
datos_completos<-imputeMCA(datos)
datos_completos<-datos_completos$completeObsComprobamos si ya no hay ninguna observación NA
plot_NA <- aggr(datos_completos, col=c('lightblue','red'), numbers=TRUE,
sortVars=TRUE, labels=names(datos),
cex.axis=.3,
gap=3, ylab=c("Histogram of missing data","Pattern"))
##
## Variables sorted by number of missings:
## Variable Count
## nnights 0
## nadults 0
## nchildren 0
## planning 0
## sex 0
## age 0
## education 0
## income 0
## region 0
## shopping 0
## antiquing 0
## scenery 0
## eatfine 0
## eatcasual 0
## eatfamstyle 0
## eatfastfood 0
## museums 0
## indoorpool 0
## outdoorpool 0
## hiking 0
## gambling 0
## boatswim 0
## fishing 0
## golfing 0
## boattours 0
## rideducks 0
## amusepark 0
## minigolf 0
## gocarting 0
## waterpark 0
## circusworld 0
## tbskishow 0
## helicopter 0
## horseride 0
## standrock 0
## outattract 0
## nearbyattract 0
## movietheater 0
## concerttheater 0
## barpubdance 0
## shopbroadway 0
## bungeejumping 0Con ello ya estarÃa solucionado el problema.
Análisis del conjunto de datos
El principal problema que atañe a esta base de datos es que todas las variables son categóricas y podrÃan considerarse como factores por lo que la parte descriptiva usual que se utilizarÃa en un dataset con datos numéricos no se puede utilizar.
Puede ser interesante comprender primero cuáles son las caracterÃsticas del público por separado (es decir, edades, hijos, etc.) y luego ver cómo se identifican con las atracciones que visitan. Comenzamos con lo primero.
Una buena técnica es ver cuántos visitantes para cada uno de los distintos niveles de los factores hay en cada variable, por ejemplo, cuál es el número de noches o el número de hijos más frecuente
nnights<-table(datos_completos$nnights)
nnights<-prop.table(nnights)
nnights<-as.data.frame(nnights)
names(nnights)<-c("Noches", "Porcentaje")
ggplot(data=nnights, mapping=aes(x=Noches, y=Porcentaje)) +
geom_col(fill="blue", alpha=0.5) +
scale_y_continuous(label=percent) +
labs(title="Noches que pasan los visitantes",
subtitle="Porcentaje de personas para 0, 1, 2, 3 o 4+ noches",
x="", y="") +
theme_bw() +
theme(title=element_text(size=14), axis.text=element_text(size=12)) +
theme(panel.grid.major.x = element_blank()) +
geom_text(mapping=aes(x=Noches, y=Porcentaje,
label=percent(Porcentaje)), size=5, nudge_y=0.03)
la mayorÃa de los visitantes pasan el dÃa en el parque y luego vuelven o bien pasan más de 2 noches siendo más de 4 no tan frecuente
nadults<-table(datos_completos$nadults)
nadults<-prop.table(nadults)
nadults<-as.data.frame(nadults)
names(nadults)<-c("Adultos", "Porcentaje")
ggplot(data=nadults, mapping=aes(x=Adultos, y=Porcentaje)) +
geom_col(fill="blue", alpha=0.5) +
scale_y_continuous(label=percent) +
labs(title="Grupos que visitan el parque",
subtitle="Número de personas en cada grupo",
x="", y="") +
theme_bw() +
theme(title=element_text(size=14), axis.text=element_text(size=12)) +
theme(panel.grid.major.x = element_blank()) +
geom_text(mapping=aes(x=Adultos, y=Porcentaje,
label=percent(Porcentaje)), size=5, nudge_y=0.03)
Aquà podemos comprobar que de la muestra, la mayorÃa de la gente va en pareja o en grupos de 2 personas siendo tan infrecuente ir en solitario como en grupo de más de 5 siendo los siguientes más frecuentes 1 o 3.
nchildren<-table(datos_completos$nchildren)
nchildren<-prop.table(nchildren)
nchildren<-as.data.frame(nchildren)
names(nchildren)<-c("Hijos", "Porcentaje")
ggplot(data=nchildren, mapping=aes(x=Hijos, y=Porcentaje)) +
geom_col(fill="blue", alpha=0.5) +
scale_y_continuous(label=percent) +
labs(title="Hijos por visitante",
subtitle="Número de hijos por visitante",
x="", y="") +
theme_bw() +
theme(title=element_text(size=14), axis.text=element_text(size=12)) +
theme(panel.grid.major.x = element_blank()) +
geom_text(mapping=aes(x=Hijos, y=Porcentaje,
label=percent(Porcentaje)), size=5, nudge_y=0.03)
Los clientes que van suelen tener ningún o 2 hijos y las familias numerosas no suelen ser habituales, lo que es lógico por el precio y las dificultades en el control de los hijos.
planning<-table(datos_completos$planning)
planning<-prop.table(planning)
planning<-as.data.frame(planning)
names(planning)<-c("Planes", "Porcentaje")
ggplot(data=planning, mapping=aes(x=Planes, y=Porcentaje)) +
geom_col(fill="blue", alpha=0.5) +
scale_y_continuous(label=percent) +
labs(title="Planificación por visitante",
subtitle="Con cuánta antelación se ha planificado la visita",
x="", y="") +
theme_bw() +
theme(title=element_text(size=14), axis.text=element_text(size=12)) +
theme(panel.grid.major.x = element_blank()) +
geom_text(mapping=aes(x=Planes, y=Porcentaje,
label=percent(Porcentaje)), size=5, nudge_y=0.03)
Respecto a la planificación, más de la mitad de los visitantes, planifican la visita con más de 1 mes de antelación o en la misma semana enla que acuden pero pocas en el mismo mes. Esto puede deberse al aprovechamiento de ofertas de última hora
sex<-table(datos_completos$sex)
sex<-prop.table(sex)
sex<-as.data.frame(sex)
names(sex)<-c("Sexo", "Porcentaje")
ggplot(data=sex, mapping=aes(x=Sexo,Porcentaje)) +
geom_col(fill="blue", alpha=0.5) +
scale_y_continuous(label=percent) +
labs(title="Sexo de los visitantes",
x="", y="") +
theme_bw() +
theme(title=element_text(size=14), axis.text=element_text(size=12)) +
theme(panel.grid.major.x = element_blank()) +
geom_text(mapping=aes(x=Sexo, y=Porcentaje,
label=percent(Porcentaje)), size=5, nudge_y=0.03)
En cuanto al sexo, más de la mitad de los visitantes son mujeres.
age<-table(datos_completos$age)
age<-prop.table(age)
age<-as.data.frame(age)
names(age)<-c("Edad", "Porcentaje")
ggplot(data=age, mapping=aes(x=Edad,Porcentaje)) +
geom_col(fill="blue", alpha=0.5) +
scale_y_continuous(label=percent) +
labs(title="Distribución por edades",
subtitle="Franjas de edades de los visitantes",
x="", y="") +
theme_bw() +
theme(title=element_text(size=14), axis.text=element_text(size=12)) +
theme(panel.grid.major.x = element_blank()) +
geom_text(mapping=aes(x=Edad, y=Porcentaje,
label=percent(Porcentaje)), size=5, nudge_y=0.03)
Por edades, el pico de gente (50%) que suele acudir es de mediana edad entre 35-44 años o entre 25 y 34 años pues es un parque enfocado a pasar el dÃa en familia.
education<-table(datos_completos$education)
education<-prop.table(education)
education<-as.data.frame(education)
names(education)<-c("Educacion", "Porcentaje")
ggplot(data=education, mapping=aes(x=Educacion,Porcentaje)) +
geom_col(fill="blue", alpha=0.5) +
scale_y_continuous(label=percent) +
labs(title="Nivel de educación",
subtitle="Educación más alta completada por cada visitante",
x="", y="") +
theme_bw() +
theme(title=element_text(size=14), axis.text=element_text(size=12)) +
theme(panel.grid.major.x = element_blank()) +
geom_text(mapping=aes(x=Educacion, y=Porcentaje,
label=percent(Porcentaje)), size=5, nudge_y=0.03)
En el nivel de educación no hay ningún predominio claro, más bien se asemeja a la realidad, es decir, el número de personas con niveles más altos de educación es menos frecuente que personas con un nivel medio o sin ella.
income<-table(datos_completos$income)
income<-prop.table(income)
income<-as.data.frame(income)
names(income)<-c("Ingresos", "Porcentaje")
ggplot(data=income, mapping=aes(x=Ingresos,Porcentaje)) +
geom_col(fill="blue", alpha=0.5) +
scale_y_continuous(label=percent) +
labs(title="Nivel de ingresos",
subtitle="Nivel de ingresos por visitante",
x="", y="") +
theme_bw() +
theme(title=element_text(size=14), axis.text=element_text(size=12)) +
theme(panel.grid.major.x = element_blank()) +
geom_text(mapping=aes(x=Ingresos, y=Porcentaje,
label=percent(Porcentaje)), size=5, nudge_y=0.03)
Curiosamente la mayorÃa de visitantes posee bajos ingresos, con medios ingresos caen y de altos ingresos casi no hay visitantes. Esto es lo que suele ocurrir porque la gente de ingresos muy altos suele acudir a otro tipo de actos recreativos y a que su número no suele ser abundante en la sociedad, un aspecto a tener en cuenta en cuestiones de marketing.
region<-table(datos_completos$region)
region<-prop.table(region)
region<-as.data.frame(region)
names(region)<-c("Region", "Porcentaje")
ggplot(data=region, mapping=aes(x=Region,Porcentaje)) +
geom_col(fill="blue", alpha=0.5) +
scale_y_continuous(label=percent) +
labs(title="Visitantes según regiones",
subtitle="Regiones de donde proceden los visitantes",
x="", y="") +
theme_bw() +
theme(title=element_text(size=14), axis.text=element_text(size=12)) +
theme(panel.grid.major.x = element_blank()) +
geom_text(mapping=aes(x=Region, y=Porcentaje,
label=percent(Porcentaje)), size=5, nudge_y=0.03)
Por regiones las personas que más acuden al parque con un 31% en total son las de Chicago seguidas de Milwaukee y de otras regiones. El parque se encuentra a 3 horas más o menos de Chicago que es el principal núcleo de población más cercano y de ahà la diferencia respecto a otras regiones
Finalmente, vemos la información relativa a las atracciones que han probado los clientes
yes_no_datos<-as.data.frame(apply(datos_completos[,c(10:42)], 2, table))
head(yes_no_datos)Como resulta más efectivo organizarla al revés, trasponemos el data frame para usarla posteriormente
yes_no_datos_df<-yes_no_datos %>% t() %>% as.data.frame()
head(yes_no_datos_df)Para visualizar más claramente la cantidad de YES y NO en todas las variables, separo en 3 tramos las representaciones. Estas son las 10 primeras desde Antigüedades hasta Compras
ggplot(gather(as.data.frame(datos_completos[,c(10:20)])), aes(value)) +
geom_bar() +
facet_wrap(~key, scales = 'free')+
theme_classic()+
labs(title="Personas que prueban o no las atracciones",
x="Respuesta", y="Nº de personas")
Las siguientes 11 (desde parque de atracciones hasta parque acuático)
ggplot(gather(as.data.frame(datos_completos[,c(21:32)])), aes(value)) +
geom_bar() +
facet_wrap(~key, scales = 'free')+
theme_classic()+
labs(title="Personas que prueban o no las atracciones",
x="Respuesta", y="Nº de personas")
Y las últimas 9 desde el pub hasta la standrock
ggplot(gather(as.data.frame(datos_completos[,c(32:42)])), aes(value)) +
geom_bar() +
facet_wrap(~key, scales = 'free')+
theme_classic()+
labs(title="Personas que prueban o no las atracciones",
x="Respuesta", y="Nº de personas")
Y ahora podemos comprobar cuáles son las atracciones que menos gustan a los clientes de la muestra (aquellas donde el número de NO es mayor al de YES) asà como las que más
dislike<-yes_no_datos_df %>% filter(NO>YES) %>% arrange(desc(NO))
like<-yes_no_datos_df %>% filter(NO<YES) %>% arrange(desc(YES))
head(like,3)head(dislike,3)Asà comprobamos que las más visitadas entre los clientes son ir de compras, el parque acuático y comprar en BroadWay mientras que las menos demandadas son el salto al vacÃo, teatro y helicóptero.
En general, aquellas más de acción o de adultos no son muy frecuentadas debido quizá a las visitas con niños o que no tienen un buen atractivo
Análisis con relaciones
Como técnica exploratoria preliminar, se puede usar la visualización que proporciona gmodels a modo de tablas de contingencia en combinación con dscr y crosstab. Por ejemplo, puede ser útil relacionar el número de noches que pasan los visitantes con su nivel de ingresos
CrossTable(datos_completos$nnights,datos_completos$income)## Cell Contents
## |-------------------------|
## | N |
## | Chi-square contribution |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
## ==============================================================================
## datos_completos$income
## datos_completos$nnights Lower Income Middle Income Upper Income Total
## ------------------------------------------------------------------------------
## 0 260 118 13 391
## 8.458 7.324 4.056
## 0.665 0.302 0.033 0.230
## 0.276 0.180 0.133
## 0.153 0.069 0.008
## ------------------------------------------------------------------------------
## 1 97 84 12 193
## 0.968 1.164 0.067
## 0.503 0.435 0.062 0.114
## 0.103 0.128 0.122
## 0.057 0.049 0.007
## ------------------------------------------------------------------------------
## 2 241 180 25 446
## 0.181 0.320 0.021
## 0.540 0.404 0.056 0.263
## 0.256 0.274 0.255
## 0.142 0.106 0.015
## ------------------------------------------------------------------------------
## 3 177 162 23 362
## 2.875 3.434 0.213
## 0.489 0.448 0.064 0.213
## 0.188 0.247 0.235
## 0.104 0.095 0.014
## ------------------------------------------------------------------------------
## 4+ 168 113 25 306
## 0.022 0.246 3.050
## 0.549 0.369 0.082 0.180
## 0.178 0.172 0.255
## 0.099 0.067 0.015
## ------------------------------------------------------------------------------
## Total 943 657 98 1698
## 0.555 0.387 0.058
## ==============================================================================Fijándonos en las filas y columnas vemos que la gente con ingresos mayores suele pasar de 2 a 4 o más dÃas en el parque, la gente de menores ingresos pasa mayoritariamente entre 1 y 3 dÃas y la gente de ingresos medios se encuentra entre ambas franjas.
Con un gráfico
crosstab(datos_completos$nnights,datos_completos$income,
xlab = "Nivel de ingresos",
ylab="Número de noches")
## Cell Contents
## |-------------------------|
## | Count |
## |-------------------------|
##
## ==============================================================================
## datos_completos$income
## datos_completos$nnights Lower Income Middle Income Upper Income Total
## ------------------------------------------------------------------------------
## 0 260 118 13 391
## ------------------------------------------------------------------------------
## 1 97 84 12 193
## ------------------------------------------------------------------------------
## 2 241 180 25 446
## ------------------------------------------------------------------------------
## 3 177 162 23 362
## ------------------------------------------------------------------------------
## 4+ 168 113 25 306
## ------------------------------------------------------------------------------
## Total 943 657 98 1698
## ==============================================================================También podemos ver cuál es el número de adultos que acuden en función de la region
CrossTable(datos_completos$region,datos_completos$nadults)## Cell Contents
## |-------------------------|
## | N |
## | Chi-square contribution |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
## =======================================================================
## datos_completos$nadults
## datos_completos$region 1 2 3 4 5+ Total
## -----------------------------------------------------------------------
## Chicago 35 328 73 47 52 535
## 2.765 0.030 1.375 0.538 2.606
## 0.065 0.613 0.136 0.088 0.097 0.315
## 0.238 0.312 0.361 0.283 0.394
## 0.021 0.193 0.043 0.028 0.031
## -----------------------------------------------------------------------
## Madison 36 170 32 23 13 274
## 6.356 0.001 0.011 0.535 3.234
## 0.131 0.620 0.117 0.084 0.047 0.161
## 0.245 0.162 0.158 0.139 0.098
## 0.021 0.100 0.019 0.014 0.008
## -----------------------------------------------------------------------
## Milwaukee 29 162 39 36 17 283
## 0.827 0.990 0.845 2.510 1.136
## 0.102 0.572 0.138 0.127 0.060 0.167
## 0.197 0.154 0.193 0.217 0.129
## 0.017 0.095 0.023 0.021 0.010
## -----------------------------------------------------------------------
## Minneapolis/StPaul 14 68 11 12 1 106
## 2.535 0.087 0.206 0.259 6.362
## 0.132 0.642 0.104 0.113 0.009 0.062
## 0.095 0.065 0.054 0.072 0.008
## 0.008 0.040 0.006 0.007 0.001
## -----------------------------------------------------------------------
## Other 16 206 35 30 34 321
## 5.002 0.269 0.266 0.061 3.279
## 0.050 0.642 0.109 0.093 0.106 0.189
## 0.109 0.196 0.173 0.181 0.258
## 0.009 0.121 0.021 0.018 0.020
## -----------------------------------------------------------------------
## Other Wisconsin 17 117 12 18 15 179
## 0.146 0.348 4.057 0.014 0.085
## 0.095 0.654 0.067 0.101 0.084 0.105
## 0.116 0.111 0.059 0.108 0.114
## 0.010 0.069 0.007 0.011 0.009
## -----------------------------------------------------------------------
## Total 147 1051 202 166 132 1698
## 0.087 0.619 0.119 0.098 0.078
## =======================================================================crosstab(datos_completos$region,datos_completos$nadults,
xlab="Número de adultos",
ylab="Region")
## Cell Contents
## |-------------------------|
## | Count |
## |-------------------------|
##
## ==============================================================
## datos_completos$nadults
## datos_completos$region 1 2 3 4 5+ Total
## --------------------------------------------------------------
## Chicago 35 328 73 47 52 535
## --------------------------------------------------------------
## Madison 36 170 32 23 13 274
## --------------------------------------------------------------
## Milwaukee 29 162 39 36 17 283
## --------------------------------------------------------------
## Minneapolis/StPaul 14 68 11 12 1 106
## --------------------------------------------------------------
## Other 16 206 35 30 34 321
## --------------------------------------------------------------
## Other Wisconsin 17 117 12 18 15 179
## --------------------------------------------------------------
## Total 147 1051 202 166 132 1698
## ==============================================================Pero la mejor herramienta para observar relaciones entre todo este conjunto de variables es usando un análisis de correspondencias múltiple MCA. Primero vemos el número de categorÃas que hay en cada variable
categorias<-apply(datos_completos[,c(1:9)], 2, function(x) nlevels(as.factor(x)))Ahora aplicamos la función de MCA
mca1<-MCA(datos_completos[,c(1:9)], graph = FALSE)
fviz_eig(mca1)
Con ello podemos comprobar que, al haber tantas variables, la que más varianza es capaz de recoger es la componente 1 con tan sólo el 6% de la total por lo que sólo podemos tomar esto para hacernos una idea general.
Para visualizar
mca1_vars_df = data.frame(mca1$var$coord, Variable = rep(names(categorias), categorias))
# data frame with observation coordinates
mca1_obs_df = data.frame(mca1$ind$coord)
# plot of variable categories
ggplot(data=mca1_vars_df,
aes(x = Dim.1, y = Dim.2, label = rownames(mca1_vars_df))) +
geom_hline(yintercept = 0, colour = "gray70") +
geom_vline(xintercept = 0, colour = "gray70") +
geom_text(aes(colour=Variable)) +
ggtitle("MCA plot of variables using R package FactoMineR")+
xlim(-1.5,2)
Donde de manera rápida puede verse que los valores alejados del punto central son los menos habituales como que haya grupos de más de 5 integrantes, personas mayores de 65 años, gente de altos ingresos o que hayan planificado esta semana el viaje
Repetimos el proceso para hacerlo con las variables relativas a atracciones
categorias2<-apply(datos_completos[,c(10:42)], 2, function(x) nlevels(as.factor(x)))
mca2<-MCA(datos_completos[,c(10:42)], graph = FALSE)
fviz_eig(mca2)
En lo relatvo a las atracciones, a diferencia del caso anterior, sà las primeras componentes sà parecen recoger gran parte de la varianza total.
Para visualizar
mca2_vars_df = data.frame(mca2$var$coord, Variable = rep(names(categorias2), categorias2))
# data frame with observation coordinates
mca2_obs_df = data.frame(mca2$ind$coord)
# plot of variable categories
ggplot(data=mca2_vars_df,
aes(x = Dim.1, y = Dim.2, label = rownames(mca2_vars_df))) +
geom_hline(yintercept = 0, colour = "gray70") +
geom_vline(xintercept = 0, colour = "gray70") +
geom_text(aes(colour=Variable)) +
ggtitle("MCA plot of variables using R package FactoMineR")+
xlim(-1.5,2)
Con el gráfico, al igual que pasó antes, se visualizan aquellas actividades que suelen ser dejadas de lado por la gente pues es raro que vayan a concerttbeater, movietheater o hiking e igual de extraño que no visiten el amusepark, outdorrpool, etc.
Proseguimos haciendo un MCA de todo el conjunto de datos
mca3<-MCA(datos_completos,graph = F)
fviz_eig(mca3)
De nuevo, las primeras variables consiguen representar algo más de varianza perosigue estando muy lejos de lo que serÃa el 60% deseable
Representando el biplot
fviz_mca_biplot(mca3,geom.ind = c("point"))
Se ve poco claro asà que representamos sólo las diferentes categorÃas
fviz_mca_var(mca3)
Se puede comprobar la gran influencia que tienen las respuestas sà y no y apreciar las atracciones deonde más personas acuden y las menos populares a la vez que se combina con las caracterÃsticas de cada encuestado.
plotellipses(mca3,keepvar=c(10:42),magnify = 1)
Con este gráfico también de FactoMiner podemos comprobar de nuevo la distribución entre YES y NO de las distintas atracciones siendo el rosa la gente que las ha probado
Es de mucha utilidad relacionar caracterÃsticas y atracciones visitadas por lo que iremos comprobando cómo se influyen mediante sucesivos gráficos para cada caracterÃstica
grp1 <- as.factor(datos_completos[, 1])
fviz_mca_biplot(mca2, geom.ind = c("point"),
habillage=grp1,labelsize=4,col.var="black",
pointsize=3,
legend.title="Nnights")
Las conclusiones que podemos sacar de este gráfico son claras: las personas que pasan un menor número de noches en el parque no visitan las atracciones que, por lo general, son bien recibidas por la gente y se concentran sobre todo en aquellas atracciones no visitadas (por falta de tiempo). A mayor número de noches, la gente va probando todas las atracciones y pasan a usar aquellas que normalmente no se visitan como concertbeatter, moviethatre, etc.
grp2 <- as.factor(datos_completos[, 2])
fviz_mca_biplot(mca2, geom.ind = c("point"),
habillage=grp2,labelsize=4,col.var="black",
pointsize=3,
legend.title="Nadults")
En cuanto al número de adultos, no parece influir en la visita a las atracciones pues todos están repartidos uniformemente
grp3 <- as.factor(datos_completos[, 3])
fviz_mca_biplot(mca2, geom.ind = c("point"),
habillage=grp3,labelsize=4,col.var="black",
pointsize=3,
legend.title="Nchildren")
Respecto al número de hijos, se aprecia claramente que aquellas personas sin ellos hacen actividades más alejadas de lo usual (normalmente no visitando aquellas a las que todo el mundo va como waterpark o eatfastfoo) y esto demuestra que se acude a las atracciones de siempre o se dejan de visitar por la presencia de hijos.
grp4 <- as.factor(datos_completos[, 4])
fviz_mca_biplot(mca2, geom.ind = c("point"),
habillage=grp4,labelsize=4,col.var="black",
pointsize=3,
legend.title="Nchildren")
La planificación también es un condicionante respecto a las atracciones que se visitan pues la gente que ha preparado con más antelación está mucho más presente en aquellos puntos que representan un YES y concentradas también en lo considerado como habitual (el centro del biplot)
grp5 <- as.factor(datos_completos[, 5])
fviz_mca_biplot(mca2, geom.ind = c("point"),
habillage=grp5,labelsize=4,col.var="black",
pointsize=3,
legend.title="Nchildren")
En cuanto al género hay una distribución bastante unforme de nuevo y lo único reseñable es el predominio de mujeres
grp6 <- as.factor(datos_completos[, 6])
fviz_mca_biplot(mca2, geom.ind = c("point"),
habillage=grp6,labelsize=4,col.var="black",
pointsize=3,
legend.title="Nchildren")
En la edad también se distinguen agrupaciones como el que las personas más mayores tienden a no visitar las atracciones más queridas o que los jóvenes menores de 25 años tienden a probar más todas las que pueden, concentrándose el resto de franjas de edades en la zona más central
grp7 <- as.factor(datos_completos[, 7])
fviz_mca_biplot(mca2, geom.ind = c("point"),
habillage=grp7,labelsize=4,col.var="black",
pointsize=3,
legend.title="Nchildren")
El nivel de educación, como es esperable, no es de relevancia a la hora de distinguir grupos
grp8 <- as.factor(datos_completos[, 8])
fviz_mca_biplot(mca2, geom.ind = c("point"),
habillage=grp8,labelsize=4,col.var="black",
pointsize=3,
legend.title="Nchildren")
Los ingresos no son algo influyente tampoco en la visita a las atracciones siendo únicamente destacable que la gente de ingresos medios parece estar más centrada en la visita y la no visita a lo habitual
grp9 <- as.factor(datos_completos[, 9])
fviz_mca_biplot(mca2, geom.ind = c("point"),
habillage=grp9,labelsize=4,col.var="black",
pointsize=3,
legend.title="Nchildren")
Para terminar, la región de procedencia tampoco es relevante.
Podemos concluir que lo que condiciona la visita a las atracciones no son factores generales de la gente (como estatus o procedencia) sino temas más tangibles como la compañÃa con la que se acude, la planificación o la propia edad. Hay atracciones que pueden ser buenas pero por el público que acude (mayoritariamente familiar o parejas) no triunfan y se recurre a otras más propias para niños (cuando se va con ellos)
grp11 <- as.factor(datos_completos[, 2])
fviz_mca_biplot(mca3, geom.ind = c("point"),
habillage=grp11,labelsize=4,col.var="black",
pointsize=3,
legend.title="Nchildren")